home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-05 / pcprl11.zip / DEVMAN.PLS < prev    next >
Text File  |  1992-02-06  |  5KB  |  230 lines
  1. program devman;
  2.  
  3. {$N+,E+,F+}
  4.  
  5. uses dos, crt, both,work, graph;
  6.  
  7. const
  8.   num_colu = 2;
  9.   num_proc = 1;
  10.  
  11. type
  12.   complex = record
  13.     realp,
  14.     imag   : double;
  15.   end;
  16.  
  17.   resu = array[1..200*num_colu] of integer;
  18.  
  19.  
  20. var
  21.   gap1,
  22.   gap2             : double;
  23.   bcorner          : complex;
  24.  
  25.   i,
  26.   j,
  27.   cur_col,
  28.   num_col,
  29.   pix_col,
  30.   start_col,
  31.   tot_col          : integer;
  32.   results          : resu;
  33.  
  34.   graphdriver,
  35.   graphmode        : integer;
  36.  
  37.  
  38.  
  39. procedure start_up;
  40.  
  41. begin
  42.  
  43.   exitsave := exitproc;
  44.   exitproc := @myexit;
  45.  
  46.   master[1] := $00;
  47.   master[2] := $00;
  48.   master[3] := $C0;
  49.   master[4] := $05;
  50.   master[5] := $86;
  51.   master[6] := $24;
  52.  
  53.   init_system;
  54.  
  55. end;
  56.  
  57.  
  58. procedure adder;
  59.  
  60.  
  61. type
  62.  
  63.   complex = record
  64.     realp,
  65.     imag   : double;
  66.   end;
  67.  
  68. var
  69.   gap1, gap2,
  70.   a,b,c,
  71.   size      : double;
  72.   bcorner,
  73.   ncomplex,
  74.   original  : complex;
  75.   cur_col,
  76.   tot_col,
  77.   num_col,
  78.   pix_col,
  79.   cc,
  80.   row,
  81.   r,
  82.   indexc,
  83.   result,
  84.   start_col,
  85.   end_col   : integer;
  86.   results   : array[1..200*num_colu] of integer;
  87.   finished  : boolean;
  88.  
  89. begin
  90.  
  91.  
  92.   in ( 'stuff', gap1, gap2, bcorner );
  93.  
  94.   in ( 'screen', cur_col, tot_col, pix_col, num_col );
  95.   if cur_col > tot_col then
  96.     begin
  97.       finished := true;
  98.     end
  99.   else
  100.     begin
  101.       finished := false;
  102.       start_col := cur_col;
  103.       end_col := cur_col + num_col - 1;
  104.       cur_col := cur_col + num_col;
  105.     end;
  106.     out ( 'screen', &cur_col, &tot_col, &pix_col, &num_col );
  107.  
  108.   while not finished do
  109.     begin
  110.       indexc := 0;
  111.       for cc := start_col to end_col do
  112.         begin
  113.           for r := 1 to pix_col do
  114.             begin
  115.               ncomplex.realp := cc * gap1 + bcorner.realp;
  116.               ncomplex.imag  := r * gap2 + bcorner.imag;
  117.               result := 0;
  118.               size := 0.0;
  119.               original.realp := 0.0;
  120.               original.imag  := 0.0;
  121.               while ( result <= 210 ) and ( size < 4.0 ) do
  122.                 begin
  123.                   a := original.realp * original.realp;
  124.                   b := original.realp * original.imag;
  125.                   c := original.imag  * original.imag;
  126.                   original.realp := a-c+ncomplex.realp;
  127.                   original.imag  := b+b+ncomplex.imag;
  128.                   size := original.realp*original.realp+original.imag*original.imag;
  129.                   inc ( result );
  130.                 end;
  131.               results[indexc+r] := result;
  132.             end;
  133.           indexc := indexc+pix_col;
  134.         end;
  135.       out ( 'col', &start_col, &results );
  136.  
  137.       in ( 'screen', cur_col, tot_col, pix_col, num_col );
  138.       if cur_col > tot_col then
  139.         begin
  140.           finished := true;
  141.         end
  142.       else
  143.         begin
  144.           start_col := cur_col;
  145.           end_col := cur_col + num_col-1;
  146.           cur_col := cur_col + num_col;
  147.         end;
  148.       out ( 'screen', &cur_col, &tot_col, &pix_col, &num_col );
  149.     end;
  150.  
  151. end;
  152.  
  153.  
  154.  
  155. procedure plot ( col : integer; results : resu );
  156.  
  157. var i,j   : integer;
  158.     color : word;
  159.  
  160. begin
  161.  
  162.  
  163. for j := 0 to num_col-1 do
  164.   for i := 1 to 200 do
  165.     begin
  166.       if results[i+j*200] < 20 then color := 1;
  167.       if results[i+j*200] > 20 then color := 9;
  168.       if results[i+j*200] > 40 then color := 2;
  169.       if results[i+j*200] > 60 then color := 10;
  170.       if results[i+j*200] > 80 then color := 4;
  171.       if results[i+j*200] > 100 then color := 12;
  172.       if results[i+j*200] > 120 then color := 5;
  173.       if results[i+j*200] > 140 then color := 13;
  174.       if results[i+j*200] > 160 then color := 8;
  175.       if results[i+j*200] > 180 then color := 7;
  176.       if results[i+j*200] > 200 then color := 0;
  177.  
  178.       putpixel ( col+j , i, color );
  179.     end;
  180.  
  181. end;
  182.  
  183.  
  184.  
  185.  
  186.  
  187. begin
  188.  
  189.   start_up;
  190.  
  191.   graphdriver := vga;
  192.   graphmode   := vgahi;
  193.   initgraph ( graphdriver, graphmode, 'a:' );
  194.  
  195.  
  196.   gap1 :=  2.50 / 320;
  197.   gap2 :=  2.50 / 200;
  198.   bcorner.realp := -2.0;
  199.   bcorner.imag  := -1.25;
  200.  
  201.   cur_col :=    1;
  202.   tot_col :=  320;
  203.   pix_col :=  200;
  204.   num_col :=    num_colu;
  205.  
  206.   for i := 1 to num_proc do
  207.     begin
  208.       eval ( 'work', &adder );
  209.       out ( 'stuff', &gap1, &gap2, &bcorner );
  210.     end;
  211.  
  212.   out ( 'screen', &cur_col, &tot_col, &pix_col, &num_col );
  213.  
  214.   for i := 1 to tot_col div num_col do
  215.     begin
  216.       in ( 'col', start_col, results );
  217.       plot ( start_col, results );
  218.     end;
  219.  
  220.   in ('screen', cur_col, tot_col, pix_col, num_col );
  221.  
  222.   readln;
  223.  
  224.  
  225.   { system_shutdown }
  226.   close_system
  227.  
  228.  
  229. end.
  230.